home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / loadit.lisp < prev    next >
Encoding:
Text File  |  1991-09-09  |  3.7 KB  |  135 lines
  1. ; -*- Mode: Lisp; Syntax: Common-Lisp; Package: (SCHI :USE (LISP)); -*-
  2. ; File loadit.lisp / Copyright (c) 1991 Jonathan Rees / See file COPYING
  3.  
  4. ;;;; Load script
  5.  
  6. ; Will not run in:
  7. ;  Symbolics versions older than Rel 7.1
  8. ;  VAX LISP versions older than V2.2
  9. ;  Explorer versions older than 3.0
  10.  
  11. (lisp:in-package "SCHI"
  12.          :use '("LISP")
  13.          :nicknames '("SCHEME-INTERNAL"))
  14.  
  15. (export '(loadit))
  16.  
  17. (defvar *pseudoscheme-directory* *default-pathname-defaults*)
  18.  
  19. (defun loadit (&optional (dir *pseudoscheme-directory*))
  20.   (setq *pseudoscheme-directory*
  21.     (let ((dir (pathname (or dir
  22.                  *default-pathname-defaults*))))
  23.       (make-pathname :name nil
  24.              :type nil
  25.              :directory (pathname-directory dir)
  26.              :device    (pathname-device dir)
  27.              :host        (pathname-host dir))))
  28.   (load-hacks)
  29.   (load-runtime)
  30.   (load-translated-translator)
  31.   (load-reflect))
  32.  
  33. ; ----- Load low-level hacks
  34.  
  35. (defvar hacks-package)
  36.  
  37. (defun load-hacks ()
  38.   (let ((*package* (or (find-package "SCHEME-HACKS")
  39.                (make-package "SCHEME-HACKS"
  40.                      :use '("LISP")
  41.                      :nicknames '("SCHH")))))
  42.     (setq hacks-package *package*)
  43.     (load (pseudo-pathname "CLEVER")
  44.       :verbose nil)            ;Get clever file loader
  45.     ;; Don't intern the symbol CLEVER-LOAD in the wrong package!
  46.     (funcall (hack-symbol "CLEVER-LOAD")
  47.          (pseudo-pathname "HACKS")
  48.          :compile-if-necessary t)
  49.     ;; Create the scheme-internal package
  50.     (funcall (hack-symbol "CLEVER-LOAD")
  51.          (pseudo-pathname "SCHI"))))
  52.  
  53. (defun hack-symbol (name)
  54.   (intern name hacks-package))
  55.  
  56. (defun pseudo-pathname (name)
  57.   (make-pathname :name (preferred-case name)
  58.          :defaults *pseudoscheme-directory*))
  59.  
  60. (defun preferred-case (name)
  61.   #+unix (string-downcase name)
  62.   #-unix name
  63.   )
  64.  
  65. ; ----- Load runtime system
  66.  
  67. (defparameter lisp-package-foo nil)
  68.  
  69. (defparameter revised^4-scheme-package nil)
  70.  
  71. (defun load-runtime ()
  72.   (let ((package (or (find-package "SCHEME")
  73.              (make-package "SCHEME" :use '()))))
  74.     (funcall (hack-symbol "FIX-SCHEME-PACKAGE-IF-NECESSARY") package)
  75.     #+Symbolics
  76.     (pushnew package si:*reasonable-packages*))
  77.  
  78.   (setq lisp-package-foo
  79.     (symbol-value (intern "LISP-PACKAGE" "SCHEME-HACKS")))
  80.  
  81.   (setq revised^4-scheme-package
  82.     (or (find-package "REVISED^4-SCHEME")
  83.         (make-package "REVISED^4-SCHEME" :use (list lisp-package-foo))))
  84.  
  85.   (mapc #'load-runtime-file
  86.     '("READTABLE"
  87.       "CORE"            ;for STRING->SYMBOL
  88.       ;; REP loop and related things
  89.       "RTS"
  90.       ))
  91.  
  92.   (load-translated "CLOSED" revised^4-scheme-package)
  93.   'done)
  94.  
  95. (defvar this-package *package*)
  96.  
  97. (defun load-runtime-file (filespec)
  98.   (let ((*package* this-package))
  99.     (funcall (hack-symbol "CLEVER-LOAD")
  100.       (pseudo-pathname (if (consp filespec) (car filespec) filespec))
  101.       :compile-if-necessary (not (consp filespec)))))
  102.  
  103. (defun load-translated (file package)
  104.   ;; PSO stands for Pseudo-Scheme Object file
  105.   (let ((*target-package* package))    ;cf. scheme-load
  106.     (declare (special *target-package*))
  107.     (funcall (hack-symbol "CLEVER-LOAD") (pseudo-pathname file)
  108.          :source-type *translated-file-type*
  109.          :compile-if-necessary t)))
  110.  
  111. ; ----- Load translator
  112.  
  113. (defparameter scheme-translator-package nil)
  114.  
  115. (defun load-translated-translator ()
  116.   (setq scheme-translator-package
  117.     (or (find-package "SCHEME-TRANSLATOR")
  118.         (make-package "SCHEME-TRANSLATOR"
  119.               :use (list revised^4-scheme-package
  120.                      lisp-package-foo))))
  121.   (let ((*package* this-package))
  122.     (funcall (hack-symbol "CLEVER-LOAD")
  123.          (pseudo-pathname "FILES")
  124.          #+LispM :package #+LispM this-package))
  125.   (mapc #'(lambda (file)
  126.         (load-translated file scheme-translator-package))
  127.     translator-files)
  128.   'done)
  129.  
  130. (defun load-reflect ()
  131.   (load-translated "REFLECT" scheme-translator-package)
  132.   (load-runtime-file "EVAL")
  133.   #+Lispm
  134.   (load-runtime-file "CUSTOM"))
  135.